(load "prelude.ss")

;; Page 37
(define (intersect set1 set2)
  (letrec ((I (lambda (set1)
                (cond ((null? set1) '())
                      ((member? (car set1) set2)
                       (cons (car set1)
                             (I (cdr set1))))
                      (else (I (cdr set1)))))))
    (I set1)))

;; Page 39
(define intersectall
  (lambda (lset)
    (letrec
      ((A (lambda (lset)
            (cond ((null? (cdr lset))
                   (car lset))
                  (else (intersect (car lset)
                                   (A (cdr lset))))))))
      (cond ((null? lset) '())
            (else (A lset))))))

;; Page 41
(define intersectall
  (lambda (lset)
    (letcc hop
           (letrec
             ((A (lambda (lset)
                   (cond
                     ((null? (car lset)) (hop '()))
                     ((null? (cdr lset)) (car lset))
                     (else (intersect (car lset)
                                      (A (cdr lset))))))))
             (cond ((null? lset) '())
                   (else (A lset)))))))

;; Page 48
(define (intersect set1 set2)
  (letrec ((I (lambda (set1)
                (cond ((null? set1) '())
                      ((member? (car set1) set2)
                       (cons (car set1)
                             (I (cdr set1))))
                      (else (I (cdr set1)))))))
    (if (null? set2)
      '()
      (I set1))))

;; Page 49
(define intersectall
  (lambda (lset)
    (letcc hop
           (letrec
             ((A (lambda (lset)
                   (cond ((null? (car lset)) (hop '()))
                         ((null? (cdr lset)) (car lset))
                         (else (I (car lset)
                                  (A (cdr lset)))))))
              (I (lambda (s1 s2)
                   (letrec ((J (lambda (s1)
                                 (cond ((null? s1) '())
                                       ((member? (car s1) s2)
                                        (cons (car s1)
                                              (J (cdr s1))))
                                       (else (J (cdr s1)))))))
                     (if (null? s2)
                       '()
                       (J s1))))))
             (cond ((null? lset) '())
                   (else (A lset)))))))

;; Page 54
(define rember-beyond-first
  (lambda (a lat)
    (letrec ((R (lambda (lat)
                  (cond
                    ((null? lat) '())
                    ((eq? (car lat) a) '())
                    (else (cons (car lat) (R (cdr lat))))))))
      (R lat))))

;; Page 57
(define (rember-upto-last a lat)
  (letcc skip
         (letrec ((R (lambda (lat)
                       (cond
                         ((null? lat) '())
                         ((eq? (car lat) a)
                          (skip (R (cdr lat))))
                         (else (cons (car lat)
                                     (R (cdr lat))))))))
           (R lat))))
